home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SCROLL.SWG / 0013_Smooth Scroll with Asm.pas < prev    next >
Pascal/Delphi Source File  |  1994-01-27  |  15KB  |  472 lines
  1. {
  2. ;
  3. ; Adapted from Programmer's Guide to PC & PS/2 Video Systems (1-55615-103-9)
  4. ;
  5. ; Routine written by Richard Wilton
  6. ;
  7. ;
  8. ; Name:         ScreenOrigin
  9. ;
  10. ; Function:     Set screen origin on EGA and VGA.
  11. ;
  12. ; Caller:       Pascal:
  13. ;
  14. ;                       ScreenOrigin(x,y : integer);
  15. ;
  16. ;                       x,y                (* pixel x,y coordinates *)
  17. ;
  18.  
  19. ; Pascal calling convention
  20.  
  21. ARGx            EQU     word ptr [bp+8] ; stack frame addressing
  22. ARGy            EQU     word ptr [bp+6]
  23.  
  24. ;
  25. ; C calling convention
  26. ;
  27. ; ARGx            EQU     word ptr [bp+4]
  28. ; ARGy            EQU     word ptr [bp+6]
  29.  
  30. CRT_MODE        EQU     49h             ; addresses in video BIOS data area
  31. ADDR_6845       EQU     63h
  32. POINTS          EQU     85h
  33. BIOS_FLAGS      EQU     89h
  34.  
  35.  
  36. DGROUP          GROUP   _DATA
  37.  
  38.  
  39. _TEXT           SEGMENT byte public 'CODE'
  40.                 ASSUME  cs:_TEXT,ds:DGROUP
  41.  
  42.                 PUBLIC  ScreenOrigin
  43. ScreenOrigin    PROC    far
  44.  
  45.                 push    bp              ; preserve caller registers
  46.                 mov     bp,sp
  47.                 push    si
  48.                 push    di
  49.  
  50.                 mov     ax,40h
  51.                 mov     es,ax           ; ES -> video BIOS data area
  52.                 mov     cl,es:[CRT_MODE]
  53.  
  54.                 mov     ax,ARGx         ; AX := pixel x-coordinate
  55.                 mov     bx,ARGy         ; BX := pixel y-coordinate
  56.  
  57.                 cmp     cl,7
  58.                 ja      L01             ; jump if graphics mode
  59.  
  60.                 je      L02             ; jump if monochrome alpha
  61.                 test    byte ptr es:[BIOS_FLAGS],1
  62.                 jnz     L02             ; jump if VGA
  63.                 jmp     short L03
  64.  
  65. ; setup for graphics modes (8 pixels per byte)
  66.  
  67. L01:
  68.                 mov     cx,8            ; CL := 8 (displayed pixels per byte)
  69.                                         ; CH := 0
  70.                 div     cl              ; AH := bit offset in byte
  71.                                         ; AL := byte offset in pixel row
  72.                 mov     cl,ah           ; CL := bit offset (for Horiz Pel Pan)
  73.                 xor     ah,ah
  74.                 xchg    ax,bx           ; AX := Y
  75.                                         ; BX := byte offset in pixel row
  76.  
  77.                 mul     word ptr BytesPerRow
  78.                                         ; AX := byte offset of start of row
  79.                 jmp     short L05
  80.  
  81. ; setup for VGA alphanumeric modes and EGA monochrome alphanumeric mode
  82. ;   (9 pixels per byte)
  83.  
  84. L02:                                    ; routine for alpha modes
  85.                 mov     cx,9            ; CL := 9 (displayed pixels per byte)
  86.                                         ; CH := 0
  87.                 div     cl              ; AH := bit offset in byte
  88.                                         ; AL := byte offset in pixel row
  89.                 dec     ah              ; AH := -1, 0-7
  90.                 jns     L04             ; jump if bit offset 0-7
  91.                 mov     ah,8            ; AH := 8
  92.                 jmp     short L04
  93.  
  94. ; setup for EGA color alphanumeric modes (8 pixels per byte)
  95.  
  96. L03:
  97.                 mov     cx,8            ; CL := 8 (displayed pixels per byte)
  98.                                         ; CH := 0
  99.                 div     cl              ; AH := bit offset in byte
  100.                                         ; AL := byte offset in pixel row
  101. L04:
  102.                 mov     cl,ah           ; CL := value for Horiz Pel Pan reg
  103.                 xor     ah,ah
  104.                 xchg    ax,bx           ; AX := y
  105.                                         ; BX := byte offset in row
  106.                 div     byte ptr es:[POINTS] ; AL := character row
  107.                                              ; AH := scan line in char matrix
  108.                 xchg    ah,ch           ; AX := character row
  109.                                         ; CH := scan line (value for Preset
  110.                                         ;       Row Scan register)
  111.                 mul     word ptr BytesPerRow ; AX := byte offset of char row
  112.                 shr     ax,1            ; AX := word offset of character row
  113. L05:
  114.                 call    SetOrigin
  115.  
  116.                 pop     di              ; restore registers and exit
  117.                 pop     si
  118.                 mov     sp,bp
  119.                 pop     bp
  120.  
  121.                 ret     4
  122.  
  123. ScreenOrigin    ENDP
  124.  
  125. SetOrigin       PROC    near            ; Caller: AX = offset of character row
  126.                                         ;         BX = byte offset within row
  127.                                         ;         CH = Preset Row Scan value
  128.                                         ;         CL = Horizontal Pel Pan value
  129.  
  130.                 add     bx,ax           ; BX := buffer offset
  131.  
  132.                 mov     dx,es:[ADDR_6845] ; CRTC I/O port (3B4h or 3D4h)
  133.                 add     dl,6            ; video status port (3BAh or 3DAh)
  134.  
  135. ; update Start Address High and Low registers
  136.  
  137. L20:
  138.                 in      al,dx           ; wait for start of vertical retrace
  139.                 test    al,8
  140.                 jz      L20
  141.  
  142. L21:
  143.                 in      al,dx           ; wait for end of vertical retrace
  144.                 test    al,8
  145.                 jnz     L21
  146.  
  147.                 cli                     ; disable interrupts
  148.                 sub     dl,6            ; DX := 3B4h or 3D4h
  149.  
  150.                 mov     ah,bh           ; AH := value for Start Address High
  151.                 mov     al,0Ch          ; AL := Start Address High reg number
  152.                 out     dx,ax           ; update this register
  153.  
  154.                 mov     ah,bl           ; AH := value for Start Address Low
  155.                 inc     al              ; AL := Start Address Low reg number
  156.                 out     dx,ax           ; update this register
  157.                 sti                     ; enable interrupts
  158.  
  159.                 add     dl,6            ; DX := video status port
  160. L22:
  161.                 in      al,dx           ; wait for start of vertical retrace
  162.                 test    al,8
  163.                 jz      L22
  164.  
  165.                 cli                     ; disable interrupts
  166.  
  167.                 sub     dl,6            ; DX := 3B4h or 3D4h
  168.                 mov     ah,ch           ; AH := value for Preset Row Scan reg
  169.                 mov     al,8            ; AL := Preset Row Scan reg number
  170.                 out     dx,ax           ; update this register
  171.  
  172.                 mov     dl,0C0h         ; DX := 3C0h (Attribute Controller
  173. port)
  174.                 mov     al,13h OR 20h   ; AL bit 0-4 := Horiz Pel Pan reg
  175. number
  176.                                         ; AL bit 5   := 1
  177.                 out     dx,al           ; write Attribute Controller Address
  178. reg
  179.                                         ;   (The Attribute Controller address
  180.                                         ;    flip-flop.)
  181.                 mov     al,cl           ; AL := value for Horiz Pel Pan reg
  182.                 out     dx,al           ; update this register
  183.  
  184.                 sti                     ; enable interrupts
  185.                 ret
  186.  
  187. SetOrigin       ENDP
  188.  
  189. _TEXT           ENDS
  190.  
  191.  
  192. _DATA           SEGMENT word public 'DATA'
  193.  
  194.                 EXTRN   BytesPerRow : word  ; bytes per pixel row
  195.  
  196. _DATA           ENDS
  197.  
  198.                 END
  199.  
  200. }
  201. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}
  202. {$M 65520,0,655360}
  203.  
  204. (****************************************************************************)
  205.  {                                                                          }
  206.  { MODULE       : SCROLL                                                    }
  207.  {                                                                          }
  208.  { DESCRIPTION  : Generic unit for perform smooth scrolling.                }
  209.  {                                                                          }
  210.  { AUTHOR       : John M. Beck                                              }
  211.  {                                                                          }
  212.  { MODIFICATIONS: None                                                      }
  213.  {                                                                          }
  214.  { HISTORY      : 29-Dec-1993  Coded.                                       }
  215.  {                                                                          }
  216. (****************************************************************************)
  217.  
  218. unit scroll;
  219.  
  220. interface
  221.  
  222. const
  223.    charwidth  = 8;
  224.    charheight = 14;  { depends on adapter }
  225.  
  226. var
  227.    screenseg    : word;
  228.    bytesperrow  : word;
  229.  
  230. function getvideomode : byte;
  231.  
  232. procedure smoothscroll;
  233.  
  234. procedure gotoxy (x,y : byte);
  235. procedure wherexy(var x,y : byte);
  236.  
  237. procedure cursoroff;
  238. procedure setcursor(top,bot : byte);
  239. procedure getcursor(var top,bot : byte);
  240.  
  241. procedure clearline(line : word);
  242. procedure setvideomode(mode : byte);
  243. procedure panscreen(x0,y0,x1,y1 : integer);
  244.  
  245. implementation
  246.  
  247. {$L SCRORG.OBJ}
  248.  
  249. {
  250. ;
  251. ; Name:         ScreenOrigin
  252. ;
  253. ; Function:     Set screen origin on EGA and VGA.
  254. ;
  255. ; Caller:       Pascal:
  256. ;
  257. ;                       procedure ScreenOrigin(x,y : integer);
  258. ;
  259. ;                       x,y               (* pixel x,y coordinates *)
  260. ;
  261. }
  262.  
  263. procedure screenorigin(x,y : integer);  external;
  264.  
  265. function getvideomode : byte; assembler;
  266.    asm
  267.       mov  ax,0F00h
  268.       int  10h
  269.    end;
  270.  
  271. procedure cursoroff; assembler;
  272.    asm
  273.       mov  cx,2000h
  274.       mov  ah,1
  275.       int  10h
  276.    end;
  277.  
  278. procedure gotoxy(x,y : byte); assembler;
  279.    asm
  280.       mov  ah,2
  281.       xor  bx,bx
  282.       mov  dl,x
  283.       dec  dl
  284.       mov  dh,y
  285.       dec  dh
  286.       int  10h
  287.    end;
  288.  
  289. procedure wherexy(var x,y : byte); assembler;
  290.    asm
  291.       mov  ax,0300h
  292.       xor  bx,bx
  293.       int  10h
  294.       xchg dx,ax
  295.       les  di,x
  296.       stosb
  297.       mov  al,ah
  298.       les  di,y
  299.       stosb
  300.    end;
  301.  
  302. procedure setvideomode(mode : byte); assembler;
  303.    asm
  304.       mov  ah,00
  305.       mov  al,mode
  306.       int  10h
  307.    end;
  308.  
  309. procedure setcursor(top,bot : byte); assembler;
  310.    asm
  311.       mov  ax,0100h
  312.       mov  ch,top
  313.       mov  cl,bot
  314.       int  10h
  315.    end;
  316.  
  317. procedure getcursor(var top,bot : byte); assembler;
  318.    asm
  319.       mov  ax,0300h
  320.       xor  bx,bx
  321.       int  10h
  322.       xchg cx,ax
  323.       les  di,bot
  324.       stosb
  325.       mov  al,ah
  326.       les  di,top
  327.       stosb
  328.    end;
  329.  
  330. procedure clearline(line : word); assembler;
  331.    asm
  332.       mov   ax,screenseg     { ; AX := screen segment              }
  333.       mov   es,ax            { ; ES := AX                          }
  334.  
  335.       mov   ax,bytesperrow   { ; AX := # chars per row * 2         }
  336.       push  ax               { ; preserve this value               }
  337.       mov   cx,line          { ; CX := Line                        }
  338.       dec   cx               { ; CX-- (zero based)                 }
  339.       mul   cx               { ; AX := bytesperrow * 25            }
  340.       mov   di,ax            { ; ES:DI -> 25th line                }
  341.       pop   cx               { ; CX := bytesperrow                 }
  342.       shr   cx,1             { ; CX := CX / 2 (word moves)         }
  343.       mov   ax,1824          { ; AH := 7 (white on black)          }
  344.                              { ; AL := 32 (space)                  }
  345.       rep   stosw            { ; clear line                        }
  346.    end;
  347.  
  348. procedure panscreen(x0,y0,x1,y1 : integer);
  349. {
  350.    Routine originally in Microsoft C by Richard Wilton
  351. }
  352.    var
  353.       i,j   : integer;
  354.       xinc,
  355.       yinc  : integer;
  356.    begin
  357.       i := x0; j := y0;
  358.  
  359.       if (x0 < x1) then
  360.          xinc := 1
  361.       else
  362.          xinc := -1;
  363.  
  364.       if (y0 < y1) then
  365.          yinc := 1
  366.       else
  367.          yinc := -1;
  368.  
  369.       while (i <> x1) or (j <> y1) do
  370.          begin
  371.             if i <> x1 then inc(i,xinc);
  372.             if j <> y1 then inc(j,yinc);
  373.             screenorigin(i,j);
  374.          end;
  375.    end;
  376.  
  377. procedure smoothscroll;
  378. {
  379.    Smooth scrolls one line up and puts cursor on bottom line.
  380. }
  381.    var
  382.       top,bot : byte;
  383.  
  384.    begin
  385.       clearline(26);               { blank 26th line             }
  386.       panscreen(0,0,0,charheight); { smooth scroll one line down }
  387.       screenorigin(0,0);           { restore screen origin       }
  388.  
  389.       asm
  390.          push  ds               { ; preserve data segment             }
  391.  
  392.          mov   ax,screenseg     { ; AX := 0B000h or 0B800             }
  393.  
  394.          mov   ds,ax            { ; DS := screen segment              }
  395.          mov   si,160           { ; SI := offset of (0,1)             }
  396.                                 { ; DS:SI -> (0,1) of video buffer    }
  397.  
  398.          mov   es,ax            { ; ES := screen segment              }
  399.          xor   di,di            { ; DI := offset of (0,0)             }
  400.  
  401.          mov   cx,1920          { ; CX := bytesperrow * 24 / 2        }
  402.  
  403.          rep   movsw            { ; move screen one line up           }
  404.  
  405.          pop   ds               { ; restore data segment              }
  406.       end;
  407.  
  408.       getcursor(top,bot);  { save cursor settings  }
  409.       clearline(25);       { blank new bottom line }
  410.       gotoxy(1,25);        { goto last line        }
  411.    end;
  412.  
  413. begin
  414.    if getvideomode = 7 then
  415.       screenseg := $B000
  416.    else
  417.       screenseg := $B800;
  418.  
  419.    bytesperrow := 80*2;        { 80 bytes for text and attributes }
  420. end.
  421.  
  422. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,P+,Q+,R+,S+,T-,V+,X+,Y+}
  423. {$M 65520,0,655360}
  424.  
  425. (****************************************************************************)
  426.  {                                                                          }
  427.  { PROGRAM      : PANTEST                                                   }
  428.  {                                                                          }
  429.  { DESCRIPTION  : Tests the scroll unit.                                    }
  430.  {                                                                          }
  431.  { AUTHOR       : John M. Beck                                              }
  432.  {                                                                          }
  433.  { MODIFICATIONS: None                                                      }
  434.  {                                                                          }
  435.  { HISTORY      : 29-Dec-1993  Coded.                                       }
  436.  {                                                                          }
  437. (****************************************************************************)
  438.  
  439. program pantest;
  440.  
  441. uses crt, scroll;
  442.  
  443. var
  444.    count : byte;
  445.  
  446. begin
  447.    clrscr;
  448.    gotoxy(1,1);
  449.    textattr := (black shl 4) or lightgray;
  450.    for count := 1 to 24 do writeln('Hello ',count);
  451.  
  452.    write('Press any key to smooth scroll up one line ... ');
  453.    readkey;
  454.  
  455.    smoothscroll;
  456.  
  457.    write('Press any key to pan demonstration ... ');
  458.    readkey;
  459.  
  460.    clrscr;
  461.    gotoxy(65,25);
  462.    textattr := (black shl 4) or lightgreen;
  463.    write('... Groovy ...');
  464.    panscreen(0,0,65 * charwidth,25 * charheight);
  465.    panscreen(65 * charwidth,25 * charheight,0,0);
  466.    gotoxy(1,25);
  467.    textattr := (black shl 4) or lightblue;
  468.    write('Any key to exit ... ');
  469.    readkey;
  470. end.
  471.  
  472.